home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jeditmodes / help-mode.tcl < prev    next >
Encoding:
Text File  |  1995-02-09  |  11.9 KB  |  458 lines
  1. # ~/.tk/edittkmodes/help-init.tcl - set up to edit jhelp help files
  2. ######################################################################
  3.  
  4. proc mode:help:init { t } {
  5.   global JEDIT_MODEPREFS TEXTWIDGET CURRENTSECTION
  6.   
  7.   j:read_prefs -array JEDIT_MODEPREFS -prefix help \
  8.     -directory ~/.tk/jeditmodes -file help-defaults {
  9.     {textfont default}
  10.     {textwidth 70}
  11.     {textheight 24}
  12.     {textwrap word}
  13.     {sabbrev 0}
  14.     {dabbrev 0}
  15.     {autobreak 0}
  16.     {autoindent 1}
  17.     {savestate 0}
  18.     {buttonbar 1}
  19.     {menu,editor 1}
  20.     {menu,file 1}
  21.     {menu,edit 1}
  22.     {menu,prefs 0}
  23.     {menu,abbrev 1}
  24.     {menu,filter 1}
  25.     {menu,format 1}
  26.     {menu,display 1}
  27.     {menu,mode1 0}
  28.     {menu,mode2 0}
  29.     {menu,user 1}
  30.   }
  31.  
  32.   global TEXTWIDGET; set TEXTWIDGET $t
  33.   global CURRENTSECTION; set CURRENTSECTION {}
  34.   toplevel .l
  35.   label .l.section -textvariable CURRENTSECTION
  36.   pack .l -expand yes
  37.   
  38.   j:rt:mkabbrevs
  39.  
  40.   $TEXTWIDGET tag configure xref-topic \
  41.     -underline 1
  42.   $TEXTWIDGET tag configure xref-section \
  43.     -underline 1
  44.   $TEXTWIDGET tag configure xref-manpage \
  45.     -underline 1
  46.   
  47.   $TEXTWIDGET tag bind xref-topic <ButtonRelease-1> {x_topic %W %x %y}
  48.   $TEXTWIDGET tag bind xref-section <ButtonRelease-1> {x_section %W %x %y}
  49.   $TEXTWIDGET tag bind xref-manpage <ButtonRelease-1> {x_manpage %W %x %y}
  50. }
  51.  
  52. proc configure_widget {{w .main.t}} {
  53.   $w tag configure j:rt:rm -font *-helvetica-medium-r-normal--*-120-*
  54.   $w configure -font *-helvetica-medium-r-normal--*-120-*
  55.   $w tag configure j:rt:it -font *-helvetica-medium-o-normal--*-120-* \
  56.     -background grey66 -borderwidth 2 -relief raised
  57.   $w tag configure j:rt:bf -font *-helvetica-bold-r-normal--*-120-* \
  58.     -background grey66 -borderwidth 2 -relief raised
  59.   $w tag configure j:rt:bi -font *-helvetica-bold-o-normal--*-120-* \
  60.     -background grey66 -borderwidth 2 -relief raised
  61.   $w tag configure j:rt:tt -font *-courier-medium-r-normal--*-120-* \
  62.     -background grey66 -borderwidth 2 -relief raised
  63.   $w tag configure j:rt:hl -font *-helvetica-bold-o-normal--*-140-* \
  64.     -background grey66 -borderwidth 2 -relief raised
  65.   
  66.   $w configure -state normal
  67. }
  68.  
  69. ######################################################################
  70.  
  71. proc section {title body} {
  72.   global TEXTWIDGET
  73.  
  74.   if {![winfo exists .menu.sections]} {
  75.     menubutton .menu.sections -text {Sections} -menu .menu.sections.m
  76.     menu .menu.sections.m
  77.     pack append .menu .menu.sections left
  78.   }
  79.  
  80.   .menu.sections.m add command -label $title -command [format {
  81.     global CURRENTSECTION
  82.     set CURRENTSECTION {%s}
  83.     $TEXTWIDGET configure -state normal
  84.     $TEXTWIDGET delete 1.0 end
  85.     j:rt text $TEXTWIDGET
  86.     eval {%s}
  87.     configure_widget $TEXTWIDGET
  88.     focus $TEXTWIDGET
  89.   } $title $body]
  90. }
  91.  
  92. ######################################################################
  93.  
  94. proc qsection {title text state} {
  95.   global TEXTWIDGET
  96.  
  97.   if {![winfo exists .menu.sections]} {
  98.     menubutton .menu.sections -text {Sections} -menu .menu.sections.m
  99.     menu .menu.sections.m
  100.     pack append .menu .menu.sections left
  101.   }
  102.  
  103.   .menu.sections.m add command -label $title -command [format {
  104.     global CURRENTSECTION
  105.     set CURRENTSECTION {%s}
  106.     $TEXTWIDGET configure -state normal
  107.     $TEXTWIDGET delete 1.0 end
  108.     j:rt text $TEXTWIDGET
  109.     $TEXTWIDGET insert 1.0 %s
  110.     j:tag:set_state $TEXTWIDGET {%s}
  111.     configure_widget $TEXTWIDGET
  112.     focus $TEXTWIDGET
  113.   } $title $text $state]
  114. }
  115.  
  116. ######################################################################
  117.  
  118. proc tagsel {{tag {}}} {
  119.   set first [.main.t index sel.first]
  120.   set last [.main.t index sel.last]
  121.   set alltags [.main.t tag names]
  122.  
  123.   foreach oldtag $alltags {
  124.     .main.t tag remove $oldtag $first $last
  125.   }
  126.  
  127.   if {$tag != {}} {
  128.     .main.t tag add $tag $first $last
  129.   }
  130. }
  131.  
  132. ######################################################################
  133.  
  134. proc mkx_topic {} {
  135.   set from [.main.t index sel.first]
  136.   set to [.main.t index sel.last]
  137.   set topic [.main.t get $from $to]
  138.   
  139.   .main.t tag add xref-topic $from $to        ;# triggers tag binding
  140.   .main.t tag add TOPIC:$topic $from $to    ;# used to figure out what
  141.                           ;# to show
  142. }
  143.  
  144. proc mkx_section {} {
  145.   set from [.main.t index sel.first]
  146.   set to [.main.t index sel.last]
  147.   set section [.main.t get $from $to]
  148.   
  149.   .main.t tag add xref-section $from $to    ;# triggers tag binding
  150.   .main.t tag add SECTION:$section $from $to    ;# used to figure out
  151.                           ;# where to go
  152. }
  153.  
  154. proc mkx_manpage {} {
  155.   set from [.main.t index sel.first]
  156.   set to [.main.t index sel.last]
  157.   set manpage [.main.t get $from $to]
  158.   
  159.   .main.t tag add xref-manpage $from $to    ;# triggers tag binding
  160.   .main.t tag add MANPAGE:$manpage $from $to    ;# used to figure out
  161.                           ;# where to go
  162. }
  163.  
  164. ######################################################################
  165. # x_topic w x y - view help topic clicked on (hypertext)
  166. ######################################################################
  167.  
  168. proc x_topic { {w} {x} {y} } {
  169.   set tags [$w tag names @$x,$y]
  170.   
  171.   foreach tag $tags {                ;# find "TOPIC:..." tag
  172.     if [string match "TOPIC:*" $tag] {
  173.       set topic [lindex [split $tag ":"] 1]    ;# get topic name
  174.       if [j:confirm -priority 100 -text "View help for `$topic'?"] {
  175.         exec jhelp $topic &
  176.       }
  177.       break
  178.     }
  179.   }
  180. }
  181.  
  182. ######################################################################
  183. # x_section w x y - go to section name clicked on (hypertext)
  184. ######################################################################
  185.  
  186. proc x_section { {w} {x} {y} } {
  187.   set tags [$w tag names @$x,$y]
  188.   
  189.   foreach tag $tags {                ;# find "SECTION:..." tag
  190.     if [string match "SECTION:*" $tag] {
  191.       set section [lindex [split $tag ":"] 1]    ;# get section name
  192.       if [j:confirm -priority 100 -text "View `$section'?"] {
  193.         .menu.sections.m invoke $section
  194.       }
  195.       break
  196.     }
  197.   }
  198. }
  199.  
  200. ######################################################################
  201. # x_manpage w x y - go to section name clicked on (hypertext)
  202. ######################################################################
  203.  
  204. proc x_manpage { {w} {x} {y} } {
  205.   set tags [$w tag names @$x,$y]
  206.   
  207.   foreach tag $tags {                ;# find "SECTION:..." tag
  208.     if [string match "MANPAGE:*" $tag] {
  209.       set manpage [lindex [split $tag ":"] 1]    ;# get section name
  210.       if [j:confirm -priority 100 -text "View `$manpage'?"] {
  211.         j:more -height 30 \
  212.           -title "Manual page for `$manpage'" \
  213.           -text [exec man $manpage |& ul -Tdumb 2>@ stdout]
  214.       }
  215.       break
  216.     }
  217.   }
  218. }
  219.  
  220. ######################################################################
  221.  
  222. proc write_section {{section_name {No Name}}} {
  223.   global FILENAME        ;# so it can be default
  224.   append FILENAME {}        ;# make sure it's defined
  225.  
  226.   set prompt_result [j:fs -prompt "Save as:"]
  227.   if {$prompt_result != {} && \
  228.      ( ! [file exists $prompt_result] || \
  229.       [j:confirm \
  230.         -text "File \"$prompt_result\" exists; replace it?"] )} then {
  231.     set FILENAME $prompt_result
  232.   } else {
  233.     return 1
  234.   }
  235.   write_section_to_file $section_name $FILENAME
  236. }
  237.  
  238. proc write_section_to_file {{section_name} {filename}} {
  239.   set file [open $filename w]
  240.   output_one_section $section_name $file
  241.   close $file
  242. }
  243.  
  244. proc output_one_section {section_name file} {
  245.   puts $file [list "qsection" "$section_name" \
  246.     [list [.main.t get 1.0 end]] \
  247.     [j:tag:get_state .main.t] \
  248.   ]
  249.   puts $file ""
  250. }
  251.  
  252. ######################################################################
  253.  
  254. proc compare_indices {i1 i2} {
  255.   set i1split [split $i1 .]
  256.   set i2split [split $i2 .]
  257.   set i1line [lindex $i1split 0]
  258.   set i1column [lindex $i1split 1]
  259.   set i2line [lindex $i2split 0]
  260.   set i2column [lindex $i2split 1]
  261.   
  262.   if {$i1line < $i2line} {
  263.     return -1
  264.   }
  265.   if {$i1line > $i2line} {
  266.     return 1
  267.   }
  268.   if {$i1column < $i2column} {
  269.     return -1
  270.   }
  271.   if {$i1column > $i2column} {
  272.     return 1
  273.   }
  274.   return 0
  275. }
  276.  
  277. ######################################################################
  278.  
  279. proc get_section_as_richtext {} {
  280.   # needs to handle hypertext
  281.   set w .main.t
  282.   
  283.   set result ""
  284.   set indices [get_indices $w]
  285.   set length [expr {[llength $indices] - 1}]
  286.   
  287.   for {set i 0} {$i < $length} {incr i} {
  288.     set first [lindex $indices $i]
  289.     set last [lindex $indices [expr {$i + 1}]]
  290.     set string [$w get $first $last]
  291.     switch -glob [$w tag names $first] {
  292.       *j:rt:rm* {
  293.         set style rm
  294.       }
  295.       *j:rt:it* {
  296.         set style it
  297.       }
  298.       *j:rt:bf* {
  299.         set style bf
  300.       }
  301.       *j:rt:tt* {
  302.         set style tt
  303.       }
  304.       *j:rt:hl* {
  305.         set style hl
  306.       }
  307.       default {
  308.         set style rm
  309.       }
  310.     }
  311.     append result "$style [list $string]\n"
  312.   }
  313.   return $result
  314. }
  315.     
  316. ######################################################################
  317.  
  318. proc get_indices {w} {
  319.   catch {unset places}
  320.   
  321.   # get a list of unique places in the text where the tagging changes
  322.   set places(1.0) {}
  323.   set places([$w index end]) {}
  324.   foreach tag [$w tag names] {
  325.     foreach index [$w tag ranges $tag] {
  326.       set places($index) {}
  327.     }
  328.   }
  329.   
  330.   set indices [array names places]
  331.   set indices [lsort -command compare_indices $indices]
  332.   return $indices
  333. }
  334.  
  335. ######################################################################
  336.  
  337. proc jedit:mode_read_proc {filename args} {
  338.   if {[winfo exists .menu.sections]} {
  339.     destroy .menu.sections
  340.   }
  341.   source $filename
  342.   # display the first section of help:
  343.   .menu.sections.m invoke 0
  344.   focus .main.t
  345. }
  346.  
  347. ######################################################################
  348. # define the help menu:
  349.  
  350. if [winfo exists .menu.help] {
  351.   destroy .menu.help
  352. }
  353.  
  354. menubutton .menu.help -text {Help} -menu .menu.help.m
  355.  
  356. menu .menu.help.m
  357. ####
  358. .menu.help.m add command -label {View Richtext} -command {
  359.   j:more -text [get_section_as_richtext]
  360. }
  361. .menu.help.m add separator
  362. .menu.help.m add command -label {Roman} -command {tagsel {}}
  363. .menu.help.m add command -label {Italic} -command {tagsel j:rt:it}
  364. .menu.help.m add command -label {Bold} -command {tagsel j:rt:bf}
  365. .menu.help.m add command -label {Bold Italic} -command {tagsel j:rt:bi}
  366. .menu.help.m add command -label {Typewriter} -command {tagsel j:rt:tt}
  367. .menu.help.m add command -label {Headline} -command {tagsel j:rt:hl}
  368. .menu.help.m add separator
  369. .menu.help.m add command -label {Section Cross Reference} \
  370.   -command {mkx_section}
  371. .menu.help.m add command -label {Topic Cross Reference} \
  372.   -command {mkx_topic}
  373. .menu.help.m add command -label {Man Page Cross Reference} \
  374.   -command {mkx_manpage}
  375. .menu.help.m add separator
  376. .menu.help.m add command -label {New Section . . .} -command {
  377.   set title [j:prompt -prompt {Section Title:}]
  378.   section $title {}
  379.   .menu.sections.m invoke $title
  380. }
  381.  
  382. pack append .menu .menu.help left
  383.  
  384. j:buttonbar .main.actions -padx 0 -pady 0 -buttons {
  385.   {
  386.     done Done {
  387.       apply_changes_to_section
  388.       jedit:cmd:save
  389.       exit 0
  390.     }
  391.   }
  392.   {
  393.     apply Apply {
  394.       apply_changes_to_section
  395.     }
  396.   }
  397.   {
  398.     topic Topic {
  399.       mkx_topic
  400.     }
  401.   }
  402.   {
  403.     section Section {
  404.       mkx_section
  405.     }
  406.   }
  407.   {
  408.     manpage "Man" {
  409.       mkx_manpage
  410.     }
  411.   }
  412. }
  413.  
  414. j:buttonbar .main.styles -padx 0 -pady 0 -buttons {
  415.   {roman Roman {tagsel {}}}
  416.   {italic Italic {tagsel j:rt:it}}
  417.   {bold Bold {tagsel j:rt:bf}}
  418.   {bi "BI" {tagsel j:rt:bi}}
  419.   {fixed Fixed {tagsel j:rt:tt}}
  420.   {head "Head" {tagsel j:rt:hl}}
  421.   {newsect "New Section" {
  422.       set title [j:prompt -prompt {Section Title:}]
  423.       section $title {}
  424.       .menu.sections.m invoke $title
  425.     }
  426.   }
  427. }
  428.  
  429. bind .main.t <Meta-minus> {.main.t insert insert "\255"}
  430.  
  431. pack .main.actions .main.styles -after .main.status -side top -fill x
  432.  
  433. proc jedit:mode_cleanup { t } {
  434.   pack unpack .menu.help
  435.   destroy .menu.help
  436.   pack unpack .menu.sections
  437.   destroy .menu.sections
  438.   pack unpack .main.actions
  439.   destroy .main.actions
  440.   pack unpack .main.styles
  441.   destroy .main.styles
  442.   pack unpack .main.status.section
  443.   destroy .main.status.section
  444.   rename configure_widget {}
  445.   rename section {}
  446.   rename qsection {}
  447.   rename tagsel {}
  448.   rename mkx_topic {}
  449.   rename mkx_section {}
  450.   rename x_topic {}
  451.   rename x_section {}
  452.   rename write_section {}
  453.   rename write_section_to_file {}
  454.   rename output_one_section {}
  455.   rename apply_changes_to_section {}
  456. }
  457.  
  458.